home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / mosmllib / Help.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  11.6 KB  |  323 lines  |  [TEXT/Moml]
  1. (* Help -- a simple Moscow ML library browser, PS 1995-04-30, 1995-11-20
  2.  
  3. Using a signature index database, 
  4.  
  5. Uses argv_ to get the library directory, then reads and displays
  6. (signature) files from that directory.
  7.  
  8. The search facility cyclically searches for occurrences of a given
  9. string, and displays the line in which the string was found, as close
  10. to the center of the display (or portion displayed) as possible.
  11.  
  12. *)
  13.  
  14. (* The number of lines to show interactively: *)
  15.  
  16. val displayLines = ref 24
  17.  
  18. local
  19. fun print s = TextIO.print s
  20.  
  21. (* Name of the signature index database, must reside in the std library: *)
  22.  
  23. val dbfilename = "helpsigs.val"
  24.  
  25. (* The database reading and searching functions.  Included here only
  26.  * to avoid loading yet another structure.  Types MUST agree with unit
  27.  * Database in mosml/src/toolssrc. *)
  28.  
  29. datatype component = 
  30.     Str                                 (* structure                       *)
  31.   | Exc of string                       (* exception constructor with name *)
  32.   | Typ of string                       (* type constructor with name      *)
  33.   | Val of string                       (* value with name                 *)
  34.   | Con of string                       (* value constructor with name     *)
  35.  
  36. type entry = { comp : component, str : string, line : int }
  37.  
  38. datatype 'contents table =
  39.     Empty
  40.   | Node of string * 'contents * 'contents table * 'contents table
  41.  
  42. type database = entry list table
  43.  
  44. fun readbase filename =
  45.     let prim_type in_channel 
  46.         type instream_  = { closed: bool, ic: in_channel } ref
  47.         prim_val input_value_ : in_channel -> 'a = 1 "intern_val"
  48.         prim_val fromI : BasicIO.instream -> instream_   = 1 "identity"
  49.         fun input_value is =
  50.             let val ref {closed, ic} = fromI is in
  51.                 if closed then
  52.                     raise SysErr("Input stream is closed", NONE)
  53.                 else
  54.                     input_value_ ic
  55.             end
  56.         val is = BasicIO.open_in_bin filename
  57.         val db = input_value is : database
  58.     in BasicIO.close_in is; db end
  59.  
  60. fun lookup(db : database, sought : string) =
  61.     let fun look Empty                      = []
  62.           | look (Node(key, value, t1, t2)) =
  63.             if sought < key then look t1
  64.             else if key < sought then look t2
  65.             else value
  66.     in look db end
  67.  
  68. (* The global variable holding the database after the first use: *)
  69.  
  70. val dbOpt = ref NONE : database option ref;
  71.  
  72. (* Auxiliaries: *)
  73.  
  74. fun min (x, y) = if x < y then x else y : int;
  75. fun max (x, y) = if x < y then y else x : int;
  76.  
  77. fun natFromString s =
  78.     let fun skipWS []              = []
  79.           | skipWS (cs as (c::cr)) = if Char.isSpace c then skipWS cr else cs
  80.         fun decval c = Char.ord c - 48
  81.         fun h []      res = SOME res
  82.           | h (c::cr) res = if Char.isDigit c then h cr (decval c + 10 * res)
  83.                             else SOME res
  84.     in 
  85.         case skipWS (String.explode s) of
  86.             []    => NONE
  87.           | c::cr => if Char.isDigit c then h cr (decval c)
  88.                      else NONE
  89.     end
  90.  
  91. fun natToString n =
  92.     (if n > 9 then natToString (n div 10) else "") 
  93.      ^ String.str (Char.chr(48 + n mod 10))
  94.     
  95. fun normalize []           = []
  96.   | normalize (#"\n" :: _) = []
  97.   | normalize (c :: cr)    = Char.toLower c :: normalize cr
  98.  
  99. fun toLower s = String.implode (normalize (String.explode s))
  100.  
  101. val slash = #":"
  102.  
  103. fun joinDirFile dir file =
  104.     let open String 
  105.     in 
  106.         if dir <> "" andalso sub(dir, size dir - 1) = slash then 
  107.             dir ^ file
  108.         else
  109.             dir ^ str slash ^ file        
  110.     end
  111.  
  112. (* The signature browser: *)
  113.  
  114. fun show name centerline initiallySought (strs : string Vector.vector) = 
  115.     let prim_val sub_ : string -> int -> char = 2 "get_nth_char";
  116.         prim_val int_to_string : int -> string = 1 "sml_string_of_int";
  117.  
  118.         val lines = Vector.length strs
  119.         val sought = ref initiallySought
  120.         fun instr s str =
  121.             let val len = String.size s
  122.                 fun eq j k = 
  123.                     j >= len orelse 
  124.                     sub_ s j = Char.toLower (sub_ str k) andalso eq (j+1) (k+1)
  125.                 val stop = String.size str - len
  126.                 fun cmp k = k<=stop andalso (eq 0 k orelse cmp(k+1))
  127.             in cmp 0 end;
  128.         fun occurshere str = 
  129.             case !sought of
  130.                 NONE   => false
  131.               | SOME s => instr s str
  132.         fun findline s curr = 
  133.             let fun h i = 
  134.                 if i >= lines then NONE
  135.                 else if instr s (Vector.sub(strs, (i+curr) mod lines)) then 
  136.                     SOME ((i + curr) mod lines)
  137.                 else h(i+1)
  138.             in h 0 end
  139.         val portion = max(!displayLines, 5) - 1
  140.         fun wait next = 
  141.             let val prompt = 
  142.                 "---- " ^ name ^ "[" ^ 
  143.                 int_to_string((100 * next) div lines) 
  144.                 ^ "%]: down, up, bottom, top, /(find), next, quit: "
  145.                 fun toend () = (print "\n....\n"; 
  146.                                 nextpart (lines - portion) portion)
  147.                 fun tobeg () = (print "\n....\n"; nextpart 0 portion)
  148.                 fun up   ()  = (print "\n....\n"; 
  149.                                 nextpart (next-3*portion div 2) portion)
  150.                 fun down ()  = if next=lines then toend()
  151.                                else nextpart next (portion div 2)
  152.                 fun find s =
  153.                     case findline s next of
  154.                         NONE      => 
  155.                             (print ("**** String \"" ^ s ^ "\" not found\n"); 
  156.                              wait next)
  157.                       | SOME line => 
  158.                             (print "\n....\n";
  159.                              nextpart (line - portion div 2) portion)
  160.                 fun search chars = 
  161.                     let val s = String.implode (normalize chars)
  162.                     in sought := SOME s; find s end
  163.                 fun findnext () =
  164.                     (case !sought of
  165.                          NONE   => (print "**** No previous search string\n"; 
  166.                                     wait next)
  167.                        | SOME s => find s)
  168.             in 
  169.                 print prompt;
  170.                 case String.explode(BasicIO.input_line BasicIO.std_in) of
  171.                     []        => ()
  172.                   | #"q" :: _ => ()
  173.                   | #"u" :: _ => up ()
  174.                   | #"d" :: _ => down ()
  175.                   | #"t" :: _ => tobeg ()
  176.                   | #"g" :: _ => tobeg ()
  177.                   | #"b" :: _ => toend ()
  178.                   | #"G" :: _ => toend ()
  179.                   | #"/" :: s => search s
  180.                   | #"n" :: s => findnext ()
  181.                   | _         => if next=lines then toend ()
  182.                                  else nextpart next portion
  183.             end
  184.         and nextpart first amount = 
  185.             let val start = max(0, min(lines - amount + 1, first))
  186.                 val stop  = min(start + amount, lines)
  187.             in prt wait start stop end
  188.         and prt wait i stop = 
  189.             if i >= stop then wait i
  190.             else 
  191.                 let val line = Vector.sub(strs, i) 
  192.                 in 
  193.                     if occurshere line then print "@>" else print "+ ";
  194.                     print line; 
  195.                     prt wait (i+1) stop
  196.                 end
  197.     in 
  198.         print "\n";
  199.         if lines <= portion then prt ignore 0 lines
  200.         else nextpart (centerline - portion div 2) portion
  201.     end
  202.  
  203. (* Find the standard library directory: *)
  204.  
  205. fun getstdlib () = 
  206.     let open Vector
  207.         prim_val argv_ : string vector = 0 "command_line";
  208.         val stop = length argv_ - 1;
  209.         fun h i = 
  210.             if i < stop then 
  211.                 if sub(argv_, i) = "-stdlib" then sub(argv_, i+1)
  212.                 else h (i+1)
  213.             else
  214.                 raise Fail "Cannot find the standard libraries!"
  215.     in h 0 end;
  216.  
  217. (* Read a signature file from the standard library: *)
  218.  
  219. fun readfile file = 
  220.     let val is = BasicIO.open_in (joinDirFile (getstdlib ()) file)  
  221.         fun h () = if BasicIO.end_of_stream is then []
  222.                    else BasicIO.input_line is :: h ()
  223.     in Vector.fromList (h ()) end;
  224.  
  225. (* Invoke the browser on a particular line of a signature: *)
  226.  
  227. fun showFile sought entry = 
  228.     (case entry of 
  229.          {comp = Str, str, ...} => 
  230.              show str 0 NONE (readfile (str ^ ".sig"))
  231.        | {comp, str, line} => 
  232.              show str line (SOME sought) (readfile (str ^ ".sig")))
  233.     handle SysErr _ => raise Fail "Help.showFile: inconsistent help database"
  234.  
  235. (* Let the user select from the menu: *)
  236.  
  237. fun choose sought entries =
  238.     let val _ = print "\nChoose number to browse, or quit: ";
  239.         val response = BasicIO.input_line BasicIO.std_in
  240.     in 
  241.         case natFromString response of
  242.             NONE => (case String.explode response of
  243.                           []        => ()
  244.                         | [#"\n"]   => ()
  245.                         | #"Q" :: _ => () 
  246.                         | #"q" :: _ => () 
  247.                         | _         => choose sought entries)
  248.           | SOME choice => 
  249.                 if choice = 0 then ()
  250.                 else showFile sought (List.nth(entries, choice - 1))
  251.     end
  252.     handle Subscript => choose sought entries
  253.          | Overflow  => choose sought entries;
  254.  
  255. (* Display the menu of identifiers matching the given one, or
  256.  * invoke the browser directly if only one match: 
  257.  *)
  258.  
  259. fun display sought []                  = raise Fail "Help.display"
  260.   | display sought [entry]             = showFile sought entry
  261.   | display sought (entries as e0::er) = 
  262.     let fun render (entry as {comp, str, ...}) =
  263.             case comp of
  264.                 Str    => "structure " ^ str
  265.               | Exc id => "exn  " ^ str ^ "." ^ id
  266.               | Typ id => "type " ^ str ^ "." ^ id
  267.               | Val id => "val  " ^ str ^ "." ^ id
  268.               | Con id => "con  " ^ str ^ "." ^ id
  269.         fun maxlen []         max = max
  270.           | maxlen (e1 :: er) max = 
  271.             let val len = size (render e1)
  272.             in maxlen er (if len > max then len else max) end
  273.         val maxwidth = maxlen er (size (render e0))
  274.         val boxwidth = 6 + 3 + 3 + maxwidth + 2
  275.         val horizontal = StringCvt.padRight #"-" boxwidth "    " ^ "\n"
  276.  
  277.         fun prline lin [] = ()
  278.           | prline lin (e1 :: rest) =
  279.             (print "    | "; 
  280.              print (StringCvt.padLeft #" " 3 (natToString lin)); 
  281.              print " | ";
  282.              print (StringCvt.padRight #" " maxwidth (render e1)); 
  283.              print " |\n";
  284.              prline (lin+1) rest)
  285.     in 
  286.         print "\n"; 
  287.         print horizontal;
  288.         prline 1 entries;
  289.         print horizontal;
  290.         choose sought entries
  291.     end
  292.  
  293. in
  294.  
  295. (* Main help function: search for a string in the signature index database: *)
  296.                         
  297. fun help "" =
  298.     show "help" 0 NONE 
  299.      #["Moscow ML library browser: \n",
  300.        "\n",
  301.        "   help \"lib\";   gives an overview of the library units\n",
  302.        "   help \"id\";    provides help on identifier id\n",
  303.        "\n"]
  304.   | help "lib" = show "Overview" 0 NONE (readfile "README")
  305.   | help "README" = show "README" 0 NONE (readfile "README")
  306.   | help id = 
  307.     let fun getdb filename = 
  308.             case !dbOpt of 
  309.                 SOME db => db
  310.               | NONE    => 
  311.                     let val db = readbase (joinDirFile (getstdlib ()) filename)
  312.                     in dbOpt := SOME db; db end
  313.                 handle SysErr _ => raise Fail "Cannot read help database!"
  314.         val db = getdb dbfilename
  315.         val sought = toLower id
  316.         val entries = lookup(db, sought)
  317.     in 
  318.         case entries of
  319.             [] => print ("\nSorry, no help on identifier `" ^ id ^ "'\n\n")
  320.           | _  => display sought entries
  321.     end
  322. end
  323.